home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro8.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-02  |  6.0 KB  |  211 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 8
  27. }
  28. PROGRAM TED_INTRO_NR8;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33.  SIZE           = 32099;
  34. VAR
  35.  BITMAP         : ARRAY [1..60,0..319] OF BYTE;
  36.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  37.  CHARS          : ARRAY [' '..']'] OF POINTER;
  38.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  39.  F              : FILE;
  40.  B,ROW,NR       : BYTE;
  41.  X,Y,I,J        : INTEGER;
  42.  CH,K           : CHAR;
  43.  TEKST          : STRING;
  44.  YINC,YPOS      : INTEGER;
  45.  YDATA          : ARRAY [0..199] OF WORD;
  46.  
  47. {───────────────────────────────────────────────────────────────────────────}
  48. {$F+}
  49. {$L FONT019F.OBJ}
  50. PROCEDURE FDATA; EXTERNAL; { .TED FILE - FONT DATA }
  51. {$L FONT019P.OBJ}
  52. PROCEDURE PDATA; EXTERNAL; { .PAL FILE - PALETTE DATA }
  53. {$F-}
  54. {───────────────────────────────────────────────────────────────────────────}
  55. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  56. ASM
  57.  MOV AX,0013H
  58.  INT 10H
  59. END;
  60. {───────────────────────────────────────────────────────────────────────────}
  61. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  62. ASM
  63.  MOV AX,0003H
  64.  INT 10H
  65. END;
  66. {───────────────────────────────────────────────────────────────────────────}
  67. PROCEDURE VSYNC; ASSEMBLER;
  68. ASM
  69.  MOV DX,03DAH
  70.  @@1: IN AL,DX; TEST AL,8; JNZ @@1;
  71.  @@2: IN AL,DX; TEST AL,8; JZ  @@2;
  72. END;
  73. {───────────────────────────────────────────────────────────────────────────}
  74. PROCEDURE DRAWBITMAP(OFSiI: WORD); ASSEMBLER;
  75. ASM
  76.  MOV DI,OFSiI
  77.  MOV ES,SEGA000
  78.  MOV SI,OFFSET BITMAP
  79.  MOV CX,9600
  80.  CLD
  81.  REP MOVSW
  82. END;
  83. {───────────────────────────────────────────────────────────────────────────}
  84. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  85. ASM
  86.   LDS SI,MAP
  87.   LES DI,MAP
  88.   INC SI
  89.   INC SI
  90.   MOV CX,9600
  91.   REP MOVSW
  92. END;
  93. {───────────────────────────────────────────────────────────────────────────}
  94. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  95. ASM
  96.  MOV DX,3C8H
  97.  MOV AL,NR
  98.  OUT DX,AL
  99.  INC DX
  100.  MOV AL,R
  101.  OUT DX,AL
  102.  MOV AL,G
  103.  OUT DX,AL
  104.  MOV AL,B
  105.  OUT DX,AL
  106. END;
  107. {───────────────────────────────────────────────────────────────────────────}
  108. PROCEDURE LOADPAL; { LOAD .PAL FILE AND SET PALETTE }
  109. BEGIN
  110.  MOVE(MEM[SEG(PDATA):OFS(PDATA)],PALETTE,768);
  111.  FOR B:=0 TO 255 DO
  112.   SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  113. END;
  114. {───────────────────────────────────────────────────────────────────────────}
  115. PROCEDURE LOADTED; { LOAD .TED FILE TO MEMORY }
  116. VAR TX,TY: BYTE; CH: CHAR;
  117.     SEGM,OFST,EOFS: WORD;
  118. BEGIN
  119.  SEGM:=SEG(FDATA);
  120.  OFST:=OFS(FDATA);
  121.  EOFS:=OFST+SIZE;
  122.  INC(OFST,20); { SKIP FILE HEADER }
  123.  WHILE NOT(OFST=EOFS) DO
  124.  BEGIN
  125.   MOVE(MEM[SEGM:OFST],CH,1); INC(OFST);
  126.   MOVE(MEM[SEGM:OFST],TX,1); INC(OFST);
  127.   MOVE(MEM[SEGM:OFST],TY,1); INC(OFST);
  128.   GETMEM(CHARS[CH],TX*TY);
  129.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  130.   MOVE(MEM[SEGM:OFST],CHARS[CH]^,TX*TY); INC(OFST,TX*TY);
  131.  END;
  132.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  133.  BEGIN
  134.   TX:=CHARSDATA['A',1];
  135.   TY:=CHARSDATA['A',2];
  136.   GETMEM(CHARS[' '],TX*TY);
  137.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  138.   CHARSDATA[' ',3]:=1;
  139.   CHARSDATA[' ',1]:=TX;
  140.   CHARSDATA[' ',2]:=TY;
  141.  END;
  142. END;
  143. {───────────────────────────────────────────────────────────────────────────}
  144. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  145. VAR CH: CHAR;
  146. BEGIN
  147.  FOR CH:=' ' TO ']' DO
  148.  BEGIN
  149.   IF CHARSDATA[CH,3]=1 THEN
  150.   BEGIN
  151.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  152.    CHARSDATA[CH,3]:=0;
  153.   END;
  154.  END;
  155. END;
  156. {───────────────────────────────────────────────────────────────────────────}
  157. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  158. VAR TX,TY,IC: INTEGER;
  159. BEGIN
  160.  IF CHARSDATA[CH,3]<>1 THEN  { CLS IF NO CHAR IN FONT }
  161.  BEGIN
  162.   FOR TY:=1 TO 60 DO BITMAP[TY,POS]:=0;
  163.  END;
  164.  IC:=(60-CHARSDATA[CH,2]) DIV 2; { START OF PIC IN "BITMAP" }
  165.  FOR TY:=1 TO 60 DO BITMAP[TY,POS]:=0;
  166.  IF RO=CHARSDATA[CH,1]+1 THEN
  167.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY+IC,POS]:=0 { SKIP ONE ROW }
  168.  ELSE
  169.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  170.    BITMAP[TY+IC,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  171. END;
  172. {───────────────────────────────────────────────────────────────────────────}
  173. PROCEDURE UPDATE; { NEW VALUES ? }
  174. BEGIN
  175.  INC(ROW);
  176.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  177.  BEGIN
  178.   ROW:=1;
  179.   INC(NR);
  180.   IF NR>LENGTH(TEKST) THEN NR:=1;
  181.  END;
  182. END;
  183. {───────────────────────────────────────────────────────────────────────────}
  184.  
  185.  
  186.  
  187. BEGIN
  188.  INITVGA;
  189.  LOADPAL;
  190.  LOADTED;
  191.  ROW:=1;
  192.  TEKST:='NOW TIME FOR PING-PONG SCROLLING......    BIGGGG SHIIIT.....              ';
  193.  NR:=1;
  194.  FILLCHAR(BITMAP,SIZEOF(BITMAP),0);
  195.  YPOS:=100;
  196.  YINC:=1;
  197.  FOR I:=0 TO 199 DO YDATA[I]:=I*320;
  198.  REPEAT
  199.   SCROLLBITMAP(BITMAP);
  200.   UPDATE;
  201.   NEWROW(TEKST[NR],ROW,318);
  202.   UPDATE;
  203.   NEWROW(TEKST[NR],ROW,319);
  204.   VSYNC;
  205.   DRAWBITMAP(YDATA[YPOS]);
  206.   YPOS:=YPOS+YINC;
  207.   IF (YPOS=40) OR (YPOS=158-CHARSDATA['A',2]) THEN YINC:=-YINC;
  208.  UNTIL KEYPRESSED;
  209.  DONETED;
  210.  CLOSEVGA;
  211. END.